perm filename INDATE.SAI[X,ALS] blob sn#089974 filedate 1974-03-05 generic text, type T, neo UTF8
00010	ENTRY PREPARE;
00020	BEGIN
00030	DEFINE ⊂="COMMENT",CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00040	DEFINE ⊃=" ";	⊂ Used to delete output statements for PLOT;
00050	DEFINE $=" ";	⊂ Used to delete outstr's;
00060	DEFINE Z="10000%256";
00070	EXTERNAL REAL ARRAY A,C,D[0:512];
00080	⊃ INTERNAL INTEGER ARRAY NEW[0:512];
00090	INTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00100	EXTERNAL INTEGER ARRAY FVAL[0:8];
00105	EXTERNAL INTEGER F1AS,F1S,F2S,F3S,F4S,F5S;
00107	EXTERNAL REAL CF1S;
00110	INTEGER I,J,K,P,POINTP,NX;
00120	⊃ EXTERNAL INTEGER CHAN5;
00130	INTERNAL INTEGER INFLAG;
00140	INTEGER F1_LOW,F1_HI,F2_LOW,F2_HI,F3_LOW,F3_HI,F4_LOW,F4_HI,F5_LOW;
00150	INTEGER F5_HI,NP_LOW,NP_HI,NZ_LOW,NZ_HI,FP1_LO,FP1_H,FP2_LO,FP2_H;
00160	INTERNAL INTEGER F1A,F1,F2,F3,F4,F5,NP,NZ,FP1,FP2,A1A,A1,A2,A3,A4,A5;
00170	INTEGER FA,FB,FC,FD,FE;
00180	INTEGER M1,M2,M3,M4,M5;
00190	
00200	
00210	
00220	
00230	INTERNAL PROCEDURE DEFINES;
00240	BEGIN
00250		F1_LOW←  180 * 256%10000;  F1_HI←  850 * 256%10000;
00260		F2_LOW←  700 * 256%10000;  F2_HI← 2500 * 256%10000;
00270		F3_LOW← 1570 * 256%10000;  F3_HI← 3400 * 256%10000;
00280		F4_LOW← 2500 * 256%10000;  F4_HI← 4500 * 256%10000;
00290		F5_LOW← 3600 * 256%10000;  F5_HI← 5400 * 256%10000;
00300	
00310		M1←	320	* 256%10000;
00320		M2←	1350	* 256%10000;
00330		M3←	2800	* 256%10000;
00340		M4←	3400	* 256%10000;
00350		M5←	4500	* 256%10000;
00360	
00370		FP1_LO← 1800 * 256%10000;  FP1_H← 3200 * 256%10000;
00380		FP2_LO← 3200 * 256%10000;  FP2_H← 5000 * 256%10000;
00390	
00400	
00410		NP_LOW←  800 * 256%10000;  NP_HI← 1500 * 256%10000;
00420		NZ_LOW←NP-500* 256%10000;  NZ_HI←NP+500* 256%10000;
00430	END;
00440	
00450	INTERNAL PROCEDURE DATOUT;
00460	BEGIN
00470	
00480	⊃ ARRYOUT(CHAN5,NEW[0],512);
00490	⊃ POINTP←POINT(9,NEW[1],-1);
00500	NX←0;
00510	 END;
00520	
00530	
00540	
     

00010	INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH);
00020	BEGIN
00030	  INTEGER I,J,K;  REAL MAX,MIN;
00040	
00050	  MAX←-10000; K←LOW;
00060	
00070	  FOR I←LOW STEP 1 UNTIL HIGH DO
00080	    IF C[I]>MAX THEN BEGIN  MAX←C[I]; J←I; END;
00090	
00100	  IF J=LOW THEN BEGIN
00110	    MAX←-10000; MIN←10000;
00120	    FOR I←LOW STEP 1 UNTIL HIGH DO BEGIN
00130	      IF C[I]>MIN THEN DONE;
00140	      IF C[I]<MIN THEN BEGIN MIN←C[I]; K←I; END;
00150	      END;
00160	
00170	    FOR I←K STEP 1 UNTIL HIGH DO
00180	      IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
00190	    END;
00200	
00210	  IF J=HIGH THEN BEGIN
00220	    MAX←-10000; MIN←10000;
00230	    FOR I←HIGH STEP -1 UNTIL K DO BEGIN
00240	      IF C[I]>MIN THEN DONE;
00250	      IF C[I]<MIN THEN MIN←C[I];
00260	      END;
00270	
00280	    FOR I←I STEP -1 UNTIL K DO
00290	      IF C[I]>MAX THEN  BEGIN  MAX←C[I]; J←I; END;
00300	    END;
00310	
00320	IF J=LOW THEN J←0;    ⊂ No proper peak found;
00330	
00340	  RETURN(J);
00350	END;
00360	
00370	INTEGER PROCEDURE BAND(INTEGER F);
00380	BEGIN
00390	  INTEGER I,J;
00400	
00410	  FOR I←F STEP 1 UNTIL  255 DO IF (C[I]+6)≤C[F] THEN DONE;
00420	⊂  OUTSTR("F="&CVS(F)&TB&"I="&CVS(I)&TB);
00430	
00440	  FOR J←F STEP -1 UNTIL 0 DO IF (C[J]+6)≤C[F] THEN DONE;
00450	⊂ OUTSTR("J="&CVS(J)&CRLF);
00460	  IF (F-J)<(I-F) THEN RETURN(F-J) ELSE RETURN(I-F);
00470	END;
00480	
00490	INTEGER PROCEDURE REMOVE(INTEGER F,LIMIT);
00500	BEGIN
00510	INTEGER I,J,K;
00520	REAL X,Y,MAX,MIN;
00530	
00540	FOR I←F STEP 1 UNTIL LIMIT DO IF C[I]≤C[F]-6 THEN BEGIN J←I; DONE; END;
00550	FOR I←F STEP -1 UNTIL 0 DO IF C[I]≤C[F]-6 THEN BEGIN K←I; DONE; END;
00560	IF ABS(F-K)<ABS(J-F) THEN I←ABS(F-K) ELSE I←ABS(J-F);
00570	X←6.0; X←X/(I*I);
00580	MAX←-10000;
00590	⊂ OUTSTR("I="&CVS(I)&"  ");
00600	
00610	FOR I←I+F STEP 1 UNTIL LIMIT DO 
00620	  IF (Y←(C[I]-C[F]+X*(I-F)*(I-F)))>MAX THEN BEGIN MAX←Y; J←I; END;
00630	IF J=LIMIT THEN J←0;
00640	
00650	RETURN(J);
00660	END;
00670	
     

00010	PROCEDURE FORMANT;
00020	BEGIN
00030	
00040	REAL X,Y;
00050	
00060	IF INFLAG=0 THEN BEGIN
00070	⊃     POINTP←POINT(9,NEW[1],-1); NX←0;
00080	
00090		INNAME[P]←CVASC("F1");	P←P+1;
00100		INNAME[P]←CVASC("F2");	P←P+1;
00110		INNAME[P]←CVASC("F3");	P←P+1;
00115		INNAME[P]←CVASC("F1A");	P←P+1;
00120		INNAME[P]←CVASC("F4");	P←P+1;
00130		INNAME[P]←CVASC("F5");	P←P+1;
00140	
00150		INNAME[P]←CVASC("A1");	P←P+1;
00160		INNAME[P]←CVASC("A2");	P←P+1;
00170		INNAME[P]←CVASC("A3");	P←P+1;
00175		INNAME[P]←CVASC("A1A");	P←P+1;
00180		INNAME[P]←CVASC("A4");	P←P+1;
00190		INNAME[P]←CVASC("A5");	P←P+1;
00200	
00210		INNAME[P]←CVASC("B1");	P←P+1;
00220		INNAME[P]←CVASC("B2");	P←P+1;
00230		INNAME[P]←CVASC("B3");	P←P+1;
00235		INNAME[P]←CVASC("B1A");	P←P+1;
00240		INNAME[P]←CVASC("B4");	P←P+1;
00250		INNAME[P]←CVASC("B5");	P←P+1;
00260	
00270	  END ELSE BEGIN
00280	$ OUTSTR(CRLF&"⊗ ");
00290	
00310	F1←PEAK(F1_LOW,F1_HI);
00315	F1A←PEAK(0,F1);
00320	F2←PEAK(F2_LOW,F2_HI);
00321	
00323	$ IF C[F1A]>C[FA] THEN OUTSTR("Voice-bar at "&CVS(F1A*Z)&",F1="&CVS(F1*Z)&",");
00330	IF (C[F1]<C[F1A])∧(C[F1]≤C[F2]) THEN BEGIN
00335	$ outstr("Remove,");
00340	  IF F2<F1_HI THEN FA←REMOVE(F1A,F2) ELSE FA←REMOVE(F1A,F1_HI);
00345	$ outstr("FA="&CVS(FA*Z)&",");
00350	  IF (C[FA]>C[F1])∧(FA≥F1_LOW-1) THEN BEGIN
00360	    $ OUTSTR("Remove,old F1="&CVS(F1*Z)&",New="&CVS(FA*Z)&TB);
00370	    F1←FA; END;
00380	  END;
00385	
00390	IF (F1+3>F1S)∧(F1+4<F2_LOW) THEN F2←PEAK(F2_LOW,F2_HI)
00400	  ELSE BEGIN
00410	    IF F1S>F2_LOW THEN F2←PEAK(F1S+1,F2_HI)
00420	      ELSE F2←PEAK(F2_LOW,F2_HI); END;
00430	
00440	F3←PEAK(F3_LOW,F3_HI);
00450	F4←PEAK(F4_LOW,F4_HI);
00460	F5←PEAK(F5_LOW,F5_HI);
00470	
00480	IF F1=F2 THEN BEGIN
00490	$  OUTSTR("F1=F2="&CVS(F1*10000%256));
00500	  FA←PEAK(F1_LOW,F1);
00510	  IF FA=0 THEN X←0 ELSE X←C[FA];
00515	  IF FA=F1 THEN X←0;
00520	  FB←PEAK(F2,F2_HI);
00530	  IF FB=0 THEN Y←0 ELSE Y←C[FB];
00540	  IF (X>Y)∧((X+6)>C[F1]) THEN F1←FA ELSE F2←FB;
00550	$ OUTSTR("FA="&CVS(FA*Z)&","&CVF(X)&"FB="&CVS(FB*Z)&","&CVF(Y)&TB);
00560	  END;
00570	
00580	IF F2=0 THEN BEGIN
00590	  F2←REMOVE(F1,F2_HI);
00600	$ OUTSTR("REMOVE ");
00610	  END;
00620	IF F2<F2_LOW THEN F2←F2S;
00630	
00640	IF (F2+4) < F3_LOW THEN F3←PEAK(F3_LOW-2,F3_HI)
00650	  ELSE F3←PEAK(F3_LOW,F3_HI);
00660	
00670	IF F2=F3 THEN BEGIN
00680	$  OUTSTR("F2=F3="&CVS(F3*10000%256));
00685	  IF CF1S>C[F1]-6 THEN FC←PEAK((F3+F3S)%2,(F3_HI+F3S+1)%2) ELSE
00690	  FC←PEAK(F3,F3_HI);
00700	  IF (FC=0)∨(FC=F2) THEN Y←0 ELSE Y←C[FC];
00710	  IF F1>F2_LOW THEN BEGIN
00715	    IF CF1S>C[F1]-6 THEN FB←PEAK((F1+F2S)%2,(F2+F2S+1)%2) ELSE FB←PEAK(F1,F2); END
00717	    ELSE BEGIN
00718	    IF CF1S>C[F1]-6 THEN FB←PEAK((F2_LOW+F2S)%2,(F2+F2S+1)%2) ELSE
00719	    FB←PEAK(F2_LOW,F2); END;
00720	  IF (FB=0)∨(FB=F2) THEN X←0 ELSE X←C[FB];
00725	  IF (X=0)∧(Y=0) THEN BEGIN F2←F2S; F3←F3S; END ELSE
00730	  IF Y≥X THEN F3←FC ELSE F2←FB;
00740	$ OUTSTR("FB="&CVS(FB*Z)&","&CVS(X)&"FC="&CVS(FC*Z)&","&CVF(Y)&TB);
00750	  END;
00760	
00770	IF ((C[F2]+24)<C[F1])∧(F1>F2_LOW) THEN BEGIN
00780	  IF F3>F2_HI THEN FB←REMOVE(F1,F2) ELSE FB←REMOVE(F1,F2_HI);
00790	  IF (FB=0)∨(FB=F2) THEN X←0 ELSE X←C[FB];
00800	  IF X>C[F2] THEN F2←FB;
00810	  END;
00820	
00830	IF F3=F4 THEN BEGIN
00840	$  OUTSTR("F3=F4="&CVS(F4*10000%256));
00850	  FD←PEAK(F4,F4_HI);
00860	  IF (FD=0)∨(FD=F3) THEN Y←0 ELSE Y←C[FD];
00870	  IF F2>F3_LOW THEN BEGIN
00871	    IF CF1S>C[F1]-6 THEN FC←PEAK((F2+F3S)%2,(F3+F3S+1)%2) ELSE FC←PEAK(F2,F3); END
00872	    ELSE BEGIN
00873	    IF CF1S>C[F1]-6 THEN FC←PEAK((F3_LOW+F3S)%2,(F3+F3S+1)%2) ELSE
00874	    FC←PEAK(F3_LOW,F3); END;
00880	  IF (FC=0)∨(FC=F3) THEN X←0 ELSE X←C[FC];
00885	  IF (X=0)∧(Y=0) THEN BEGIN F3←F3S; F4←F4S; END ELSE
00890	  IF Y+3≥X THEN F4←FD ELSE F3←FC;
00900	$ OUTSTR("FC="&CVS(FC*Z)&","&CVS(X)&"FD="&CVS(FD*Z)&","&CVF(Y)&TB);
00910	  END;
00920	
00930	IF F4=F5 THEN BEGIN
00940	$ OUTSTR("F4=F5="&CVS(F5*10000%256));
00950	  FE←PEAK(F5,F5_HI);
00960	  IF (FE=0)∨(FE=F5) THEN Y←0 ELSE Y←C[FE];
00970	  IF F3>F4_LOW THEN BEGIN
00971	    IF CF1S>C[F1]-6 THEN FD←PEAK((F3+F4S)%2,(F4+F4S+1)%2) ELSE FD←PEAK(F3,F4); END
00972	    ELSE BEGIN
00973	    IF CF1S>C[F1]-6 THEN FD←PEAK((F4_LOW+F4S)%2,(F4+F4S+1)%2) ELSE
00974	    FD←PEAK(F4_LOW,F4); END;
00980	  IF (FD=0)∨(FD=F4) THEN X←0 ELSE X←C[FD];
00985	  IF (X=0)∧(Y=0) THEN BEGIN F4←F4S; F5←F5S; END ELSE
00990	  IF Y+3≥X THEN F5←FE ELSE F4←FD;
01000	$ OUTSTR("FD="&CVS(FD*Z)&","&CVS(X)&"FE="&CVS(FE*Z)&","&CVF(Y)&TB);
01010	  END;
01020	
01025	  IF F1=F1A THEN F1A←PEAK(0,F1); IF F1=F1A THEN F1A←0;
01030	$ OUTSTR(CRLF&TB&CVS(F1A*Z)&"-"&CVS(F1*Z)&","&CVS(F2*Z)&","&CVS(F3*Z)&","&CVS(F4*Z)
01040	      &","&CVS(F5*Z)&CRLF);
01050	
01060		INDATA[P]←F1S←F1;		P←P+1;
01070		INDATA[P]←F2S←F2;		P←P+1;
01080		INDATA[P]←F3S←F3;		P←P+1;
01085		INDATA[P]←F1AS←F1A;		P←P+1;
01090		INDATA[P]←F4S←F4;		P←P+1;
01100		INDATA[P]←F5S←F5;		P←P+1;
01110		INDATA[P]←CF1S←C[F1];	P←P+1;
01120		INDATA[P]←C[F2];	P←P+1;
01130		INDATA[P]←C[F3];	P←P+1;
01135		INDATA[P]←C[F1A];	P←P+1;
01140		INDATA[P]←C[F4];	P←P+1;
01150		INDATA[P]←C[F5];	P←P+1;
01160	
01170		INDATA[P]←BAND(F1)*10000%256;	P←P+1;
01180		INDATA[P]←BAND(F2)*10000%256;	P←P+1;
01190		INDATA[P]←BAND(F3)*10000%256;	P←P+1;
01192		INDATA[P]←BAND(F1A)*10000%256;	P←P+1;
01195		INDATA[P]←BAND(F1A)*10000%256;	P←P+1;
01200		INDATA[P]←BAND(F4)*10000%256;	P←P+1;
01210		INDATA[P]←BAND(F5)*10000%256;	P←P+1;
01220	  END;
01230	END;
01240	
     

00010	INTERNAL PROCEDURE PREPARE;
00020	BEGIN
00030	
00040	  P←0;
00050	
00060	  FORMANT;
00070	
00080	
00090	⊃ IF INFLAG≠0 THEN BEGIN
00100	⊃   NEW[NX]←FVAL[4];
00110	⊃     FOR I←0 STEP 1 UNTIL 27 DO  IDPB(INDATA[I],POINTP);
00120	⊃     FOR I←1 STEP 1 UNTIL 4 DO IBP(POINTP);
00130	⊃   NX←NX+8;
00140	⊃   IF NX≥512 THEN DATOUT; 
00150	⊃   END;
00160	
00170	END;
00180	
00190	END;
00200